home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-05-08 | 7.4 KB | 213 lines | [TEXT/PJMM] |
- unit ShowInitIcon;
-
- { ShowInitIcon - version 1.0, May 8th, 1995 }
- { This code is intended to let INIT writers easily display an icon at startup time. }
- { View in Geneva 9pt, 4-space tabs }
-
- { Written by: Peter N Lewis <peter@mail.peter.com.au>, Jim Walker <JWWalker@aol.com> }
- { and François Pottier <pottier@dmi.ens.fr>, with thanks to previous ShowINIT authors. }
- { Send comments and bug reports to François Pottier. }
-
- { This version features: }
- { - Short and readable code. }
- { - Correctly wraps around when more than one row of icons has been displayed. }
- { - works with System 6 }
- { - Built with Think Pascal. Should work with other headers/compilers. }
-
- interface
-
- uses
- Types;
-
- { --------------------------------------------------------------------------------------------------------------------- }
- { Set this to 1 if you want to compile this file into a stand-alone resource. (see notes below) }
-
- {$SETC STANDALONE:=0}
-
- {$IFC STANDALONE}
- procedure Main (iconFamilyID: integer; advance: Boolean);
- {$ELSEC}
- procedure ShowInitIcon (iconFamilyID: integer; advance: Boolean);
- {$ENDC}
-
- implementation
-
- uses
- Icons, OSUtils, Resources, Memory, QuickDraw;
-
- { --------------------------------------------------------------------------------------------------------------------- }
- { The ShowINIT mechanism works by having each INIT read/write data from these globals. }
-
- type
- LMShowInitRecord = packed record
- LMVCheckSum: integer;
- LMVCoord: integer;
- LMHCoord: integer;
- LMHCheckSum: integer;
- end;
- LMShowInitRecordPtr = ^LMShowInitRecord;
-
- const
- LMShowInitRecordAddr = $928; { Low Memory address of record }
-
- { --------------------------------------------------------------------------------------------------------------------- }
- { Main must be the first function in the file for THINK Pascal's "Custom header" option to work. }
-
- function CheckSum (x: integer): integer;
- forward;
- procedure ComputeIconRect (var iconRect: Rect; var bounds: Rect);
- forward;
- procedure AdvanceIconPosition (var iconRect: Rect);
- forward;
- procedure DrawBWIcon (iconID: integer; var iconRect: Rect);
- forward;
-
- { --------------------------------------------------------------------------------------------------------------------- }
- { Main routine. }
-
- { You will probably need this definition of QDGlobals if you use Think Pascal. CodeWarrior doesn't need it. }
- {$IFC 1}
- type
- QDGlobals = record
- privates: packed array[1..76] of Byte;
- randSeed: longint;
- screenBits: BitMap;
- arrow: Cursor;
- dkGray, ltGray, gray, black, white: Pattern;
- thePort: GrafPtr;
- end;
- {$ENDC}
-
- type
- QDStorage = record
- qd: QDGlobals; { Storage for the QuickDraw globals }
- qdGlobalsPtr: Ptr; { A5 points to this place; it will contain a pointer to qd }
- end;
-
- {$IFC STANDALONE}
- procedure Main (iconFamilyID: integer; advance: Boolean);
- {$ELSEC}
- procedure ShowInitIcon (iconFamilyID: integer; advance: Boolean);
- {$ENDC}
- var
- oldA5: longInt;
- qds: QDStorage; { Fake QD globals }
- colorPort: CGrafPort;
- bwPort: GrafPort;
- destRect: Rect;
- environment: SysEnvRec; { Machine configuration. }
- junk: OSErr;
-
- begin
-
- oldA5 := SetA5(longInt(@qds.qdGlobalsPtr)); { Tell A5 to point to the end of the fake QD Globals }
- InitGraf(@qds.qd.thePort); { Initialize the fake QD Globals }
-
- junk := SysEnvirons(curSysEnvVers, environment); { Find out what kind of machine this is}
-
- ComputeIconRect(destRect, qds.qd.screenBits.bounds); { Compute where the icon should be drawn }
-
- if (environment.systemVersion >= $0700) & environment.hasColorQD then begin
- OpenCPort(@colorPort);
- junk := PlotIconID(destRect, atNone, ttNone, iconFamilyID);
- CloseCPort(@colorPort);
- end
- else begin
- OpenPort(@bwPort);
- DrawBWIcon(iconFamilyID, destRect);
- ClosePort(@bwPort);
- end;
-
- if advance then
- AdvanceIconPosition(destRect);
-
- oldA5 := SetA5(oldA5); { Restore A5 to its previous value }
- end;
-
- { --------------------------------------------------------------------------------------------------------------------- }
- { A checksum is used to make sure that the data in there was left by another ShowINIT-aware INIT. }
-
- function CheckSum (x: integer): integer;
- begin
- CheckSum := BXOR(BOR(BSL(x, 1), BSR(x, 15)), $1021);
- end;
-
- { --------------------------------------------------------------------------------------------------------------------- }
- { ComputeIconRect computes where the icon should be displayed. }
-
- procedure ComputeIconRect (var iconRect: Rect; var bounds: Rect);
- var
- lmp: LMShowInitRecordPtr;
- begin
- lmp := LMShowInitRecordPtr(LMShowInitRecordAddr);
-
- if (CheckSum(lmp^.LMHCoord) <> lmp^.LMHCheckSum) then { If we are first, we need to initialize the shared data. }
- lmp^.LMHCoord := 8;
- if (CheckSum(lmp^.LMVCoord) <> lmp^.LMVCheckSum) then
- lmp^.LMVCoord := bounds.bottom - 40;
-
- if (lmp^.LMHCoord + 34 > bounds.right) then begin { Check whether we must wrap }
- iconRect.left := 8;
- iconRect.top := lmp^.LMVCoord - 40;
- end
- else begin
- iconRect.left := lmp^.LMHCoord;
- iconRect.top := lmp^.LMVCoord;
- end;
-
- iconRect.right := iconRect.left + 32;
- iconRect.bottom := iconRect.top + 32;
- end;
-
- { AdvanceIconPosition updates the shared globals so that the next icon will draw its icon next to ours. }
-
- procedure AdvanceIconPosition (var iconRect: Rect);
- var
- lmp: LMShowInitRecordPtr;
- begin
- lmp := LMShowInitRecordPtr(LMShowInitRecordAddr);
- lmp^.LMHCoord := iconRect.left + 40; { Update the shared data }
- lmp^.LMVCoord := iconRect.top;
- lmp^.LMHCheckSum := CheckSum(lmp^.LMHCoord);
- lmp^.LMVCheckSum := CheckSum(lmp^.LMVCoord);
- end;
-
- { DrawBWIcon draws the 'ICN#' member of the icon family. It works under System 6. }
-
- procedure DrawBWIcon (iconID: integer; var iconRect: Rect);
- var
- icon: Handle;
- source, destination: BitMap;
- port: GrafPtr;
- begin
- icon := Get1Resource('ICN#', iconId);
- if (icon <> nil) then begin
- HLock(icon);
- { Prepare the source and destination bitmaps. }
- source.baseAddr := Ptr(longInt(icon^) + 128); { Mask address. }
- source.rowBytes := 4;
- SetRect(source.bounds, 0, 0, 32, 32);
- GetPort(port);
- destination := port^.portBits;
- { Transfer the mask. }
- CopyBits(source, destination, source.bounds, iconRect, srcBic, nil);
- { Then the icon. }
- source.baseAddr := icon^;
- CopyBits(source, destination, source.bounds, iconRect, srcOr, nil);
- end;
- end;
-
- { --------------------------------------------------------------------------------------------------------------------- }
- { Notes }
-
- { Checking for PlotIconID: }
- { We (PNL) now check for system 7 and colour QD, and use colour graf ports and PlotIconID only if both are true }
- { Otherwise we use B&W grafport and draw using PlotBWIcon. }
-
- { Should I use it as a standalone code resource or link it into my INIT? }
- { I recommend linking the code to your INIT resource, because it's easier and cleaner, *provided* that your INIT resource is }
- { written properly, that is, it is destroyed once startup is over. If your INIT installs trap patches, then the code for the trap }
- { patches should be compiled into a separate resource (or code fragment, on the PowerPC) and only the code for the patches }
- { should remain resident. Filling the System heap with old INIT code isn't cool. }
-
- end.